home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / drives.swg / 0069_Volume Serial Number.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  2.2 KB  |  85 lines
  1.  
  2. unit xdos;
  3.  
  4. Interface
  5.   function  GetVolSerialNo(DriveNo:Byte): string;
  6.   Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);
  7.  
  8. Implementation
  9. uses dos,crt;
  10.  
  11. type
  12.   SerNo_type       =
  13.                      record
  14.                      case integer of
  15.                        0: (SerNo1, SerNo2    : word);
  16.                        1: (SerNo              : longint);
  17.                      end;
  18.  
  19.   DiskSerNoInfo_type = record
  20.                      Infolevel : word;
  21.                      VolSerNo  : SerNo_Type;
  22.                      VolLabel  : array[1..11] of char;
  23.                      FileSys   : array[1..8] of char;
  24.                      end;
  25.  
  26.  
  27. function HexDigit(N : Byte) : char;
  28. begin
  29.   if n < 10 then HexDigit := Chr(Ord('0')+n)
  30.   else           HexDigit := Chr(Ord('A') + (n - 10));
  31. end;
  32.  
  33.  
  34. function GetVolSerialNo(DriveNo:Byte): string;
  35. var
  36.   ReturnArray                  : DiskSerNoInfo_type;
  37.   Regs                         : Registers;
  38. begin
  39.   with regs do begin
  40.     AX := $440d;
  41.     BL := DriveNo;
  42.     CH := $08;
  43.     CL := $66;
  44.     DS := Seg(ReturnArray);
  45.     DX := Ofs(ReturnArray);
  46.     Intr($21,Regs);
  47.     if (Flags and FCarry)<>0 then GetVolSerialNo := '' else
  48.     with ReturnArray.VolSerNo do
  49.     GetVolSerialNo :=HexDigit(Hi(SerNo2) Div 16) + HexDigit(Hi(SerNo2) Mod 16)
  50. +
  51.                      HexDigit(Lo(SerNo2) Div 16) + HexDigit(Lo(SerNo2) Mod 16)
  52. +
  53.                      HexDigit(Hi(SerNo1) Div 16) + HexDigit(Hi(SerNo1) Mod 16)
  54. +
  55.                      HexDigit(Lo(SerNo1) Div 16) + HexDigit(Lo(SerNo1) Mod 16);
  56.   end;
  57. end;
  58.  
  59. Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);
  60. var
  61.   ReturnArray                  : DiskSerNoInfo_type;
  62.   Regs                         : Registers;
  63. begin
  64.   with regs do begin
  65.     AX := $440d;
  66.     BL := DriveNo;
  67.     CH := $08;
  68.     CL := $66;
  69.     DS := Seg(ReturnArray);
  70.     DX := Ofs(ReturnArray);
  71.     Intr($21,Regs);
  72.     if (Flags and FCarry)=0 then begin
  73.        ReturnArray.VolSerNo.SerNo := SerialNo;
  74.        AH := $69;
  75.        BL := DriveNo;
  76.        AL := $01;
  77.        DS := Seg(ReturnArray);
  78.        DX := Ofs(ReturnArray);
  79.        Intr($21,Regs);
  80.     end;
  81.   end;
  82. end;
  83.  
  84. end.
  85.